home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
pas_all.zip
/
TI552.ASC
< prev
next >
Wrap
Text File
|
1992-08-12
|
21KB
|
859 lines
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 1/13
TITLE : Unit for Printing in Windows
{***********************************************}
{ }
{ Turbo Pascal for Windows }
{ WinPrint Unit }
{ Printer Module for use with OWL }
{ }
{***********************************************}
unit WinPrint;
{$R PRINTER}
interface
uses WinTypes, WinProcs, WObjects, Strings;
type
{/// TComboXferRec ///}
TComboXferRec = record
Strings: PStrCollection;
Selection: array[0..80] of Char;
end;
{ The transfer buffer used for the ComboBox in the TPrinterInfo
method SelectPrinter. The fields, Strings and Selection, are
set up in the TPrinterInfo constructor Init. The routine
GetCurrentPrinter is used to find current printing device which
is placed in Selection. And the routine GetPrinterTypes is
used to fill out the Strings field.}
{/// TAbortDialog ///}
PAbortDialog = ^TAbortDialog;
TAbortDialog = object(TWindow)
procedure SetUpWindow; virtual;
procedure WMCommand(var Msg: TMessage);
virtual wm_First + wm_Command;
end;
{ A descendant of TDialog used for the Abort Dialog seen when
printing is in progress. The AbortDialog is installed as a data
field of TPrinterInfo and is initialized and displayed in its
StartDoc method. The EndDoc method will Close the dialog if
necessary.}
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 2/13
TITLE : Unit for Printing in Windows
{/// TPrinterInfo ///}
PPrinterInfo = ^TPrinterInfo;
TPrinterInfo = object
AbortDialog: PAbortDialog;
AbortDlg: HWnd;
AbortCallBackProc: TFarProc;
SelectDialog: PDialog;
SelectInfo: TComboXferRec;
Driver,
PrinterType,
Port: PChar;
DriverHandle: THandle;
PrintDC: HDC;
Error: Integer;
ExtDeviceMode: TExtDeviceMode;
DeviceModeVar: TDeviceMode;
RasterCaps: integer;
constructor Init;
destructor Done;
procedure SelectPrinter; virtual;
function GetPrinterDC: HDC;
procedure DeviceMode;
function BitMapCapable: boolean;
function BandingRequired: boolean;
procedure StartDoc(Name: PChar; AbortBox: Boolean); virtual;
procedure NewFrame; virtual;
procedure NextBand(var R:TRect); virtual;
procedure EndDoc; virtual;
end;
{ The controlling object for printing. It is intended that this
object be initialized as a data field of a TWindow or
TApplication descendant. This printing object must be used OWL
based applications. The data fields are not supposed to be used
directly but may need to be accessed in special situations.
PrintDC and Error are the two most likely to be used without a
specific method call. The description of the data fields are
as follows.
-AbortDialog holds a pointer to the abort dialog when it valid.
It is valid only after a call to the method StartDoc and before
the call to the method EndDoc.
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 3/13
TITLE : Unit for Printing in Windows
-AbortCallBackProc holds the address of the Abort Dialog's
callback function. It's definition is found in the function
AbortCallBack in the implementation section of this unit.
-SelectDialog is a pointer to the dialog used when selecting
the current printer. To be used when overriding the function of
the SelectPrinter method.
-SelectInfo is the transfer record used in SelectDialog. Holds
descriptions of all printers available and the currently
selected printer.
-Driver, PrinterType, Port are null terminated strings holding
information relevant to the current printer.
-DriverHandle is a handle to the library of the current printer
driver. It is setup in Init constructor and is freed in the
Done destructor. It is used for setting up the DeviceMode
configuration call.
-PrintDC is the device control established for printing. It is
created by the StartDoc method and valid until the EndDoc
method call. May be accessed directly or by the GetPrinterDC
method call.
-Error holds the results of printer escape calls. If an error
occurs, the result is placed here. Is tested to determine if
further printing output is appropriate.
-ExtDeviceMode holds the ExtDeviceMode procedure used for
retrieving, installing, and prompting for printing
configurations.
-DeviceModeVar holds the DeviceMode procedure used for
prompting the user for printer configurations.
For most programs, there is no need to access the data fields
of this object directly. Call the appropriate method for the
operations detailed below.
-Init retrieves the current printer configuration and sets up
the ExtDEviceMode and DeviceMode address from the current
printer's library.
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 4/13
TITLE : Unit for Printing in Windows
-Done frees the library associated with the current printer.
-SelectPrinter displays a printer select dialog permitting the
user to change the current printer information.
-GetPrinterDC retrieves the device control associated with the
printer. Must be called after StartDoc.
-DeviceMode calls the printer driver's DeviceMode routine.
-BitMapCapable returns true if the current printing device can
handle bitmap graphics.
-BandingRequired returns true if banding of bitmap images will
enhance printing speed.
-StartDoc is called immediately before printing is to begin.
Establishes the device control. Sets up the abort dialog and
sends the STARTDOC escape call.
-NewFrame sends the NEWFRAME escape call and performs
appropriate error checking.
-EndDoc sends the ENDDOC escape call and closes the Abort
Dialog if no errors have occurred.
}
var
PrinterAbort: Boolean;
{ Holds true when the user has aborted printing. }
implementation
const
id_ComboBox = 101;
{ ID for the ComboBox used for Selecting the current printer }
var
AbortWindow: HWnd;
{ Window handle for the Abort Dialog. It is used by the
AbortCallBackProc.}
function GetItem(var S: PChar): PChar;
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 5/13
TITLE : Unit for Printing in Windows
{ Retrieves comma separated data from a null terminated string.
It returns the first data item and advances the pointer S to
the next data item in the string. }
var
P: PChar;
I: Integer;
begin
I:=0;
while (S[I]<>',') and (S[I]<>#0) do
inc(I);
S[I]:=#0;
GetMem(P, Strlen(S)+1);
StrCopy(P,S);
GetItem:=P;
I+1
if S[0]<>#0 then S:= ;
end;
procedure GetPrinterTypes(var PrinterTypes: PStrCollection);
{ Retrieves all the device types from the WIN.INI and places this
information into the PStrCollection parameter.}
var
Buffer, BufferItem: PChar;
Item: PChar;
Count, I: Integer;
begin
New(PrinterTypes, init(5,1));
GetMem(Buffer, 1024);
Count:=GetProfileString('devices', nil, ',,', Buffer, 1024);
BufferItem:=Buffer;
I:=0;
while I<Count do
begin
GetMem(Item, StrLen(BufferItem)+1);
StrCopy(Item, BufferItem);
PrinterTypes^.Insert(Item);
while (BufferItem[i]<>#0) and (I<Count) do
inc(I);
inc(I);
if BufferItem[I]=#0 then I:=Count;
if I<Count then
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 6/13
TITLE : Unit for Printing in Windows
begin
BufferItem:=@ BufferItem[I];
Count:=Count-I;
I:=0;
end;
end;
FreeMem(Buffer, 1024);
end;
procedure GetCurrentPrinter(var Driver, PrinterType,
Port: PChar);
{ Retrieves the current printing device information from the
WIN.INI file.}
var
ProfileInfo, CurrentItem: PChar;
begin
GetMem(ProfileInfo, 80+1);
GetProfileString('windows', 'device', ',,', ProfileInfo, 80);
CurrentItem:=ProfileInfo;
PrinterType:=GetItem(CurrentItem);
Driver:=GetItem(CurrentItem);
Port:=GetItem(CurrentItem);
FreeMem(ProfileInfo, 80+1);
end;
procedure GetPrinter(PrinterType: PChar; var Driver,
Port: PChar);
{ Given a PrinterType string, this procedure returns the
appropriate driver and port information.}
var
ProfileInfo, CurrentItem: PChar;
begin
GetMem(ProfileInfo, 80+1);
GetProfileString('devices', PrinterType, ',', ProfileInfo, 80);
CurrentItem:=ProfileInfo;
Driver:=GetItem(CurrentItem);
Port:=GetItem(CurrentItem);
end;
procedure TAbortDialog.SetUpWindow;
{ Initializes PrinterAbort and AbortWindow. Then set the focus to
the AbortDialog.}
begin
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 7/13
TITLE : Unit for Printing in Windows
PrinterAbort:=false;
SetFocus(HWindow);
AbortWindow:=HWindow;
end;
procedure TAbortDialog.WMCommand(var Msg: TMessage);
{ If any command messages occur, a user abort has taken place.
Normally, this will include pressing ENTER, ESCAPE, the
SPACEBAR or clicking the mouse on the Abort Dialog's Escape
button.}
begin
PrinterAbort:=true;
end;
function AbortDlgProc(Dlg: HWnd; Message, WParam: Word;
LParam: LongInt) : Bool; export;
var
Result: Bool;
begin
case Message of
WM_INITDIALOG:
begin
PrinterAbort := False;
SetFocus(Dlg);
AbortWindow := Dlg;
Result :=true;
end;
WM_COMMAND:
begin
Result := true;
end;
else Result := false;
end;
AbortDlgProc := Result;
end;
function AbortCallBack(DC: HDC; Code: Integer): Bool; export;
{ While printing is taking place, checks to see if PrinterAbort
is true. Otherwise messages are passed on.}
var
Msg: TMsg;
begin
while (not PrinterAbort) and
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 8/13
TITLE : Unit for Printing in Windows
PeekMessage(Msg, 0, 0, 0, pm_Remove) do
if not IsDialogMessage(AbortWindow, Msg) then begin
TranslateMessage(Msg);
DispatchMessage(Msg);
end;
if PrinterAbort then AbortCallBack:=false
else AbortCallBack:=true;
end;
constructor TPrinterInfo.Init;
{ Gets the current printer information (Type, Driver, & Port) and
the printer types currently available. Then retrieves the
ExtDeviceMode and DeviceModeVar address from the current
printer's library.}
var
I: Integer;
FullDriverName: PChar;
P: TFarProc;
begin
GetCurrentPrinter(Driver, PrinterType, Port);
for I:= 0 to StrLen(PrinterType) do
SelectInfo.Selection[I]:=PrinterType[I];
GetPrinterTypes(SelectInfo.Strings);
GetMem(FullDriverName, 12+1);
StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
DriverHandle:=LoadLibrary(FullDriverName);
FreeMem(FullDriverName, 12+1);
P:=GetProcAddress(DriverHandle, 'ExtDeviceMode');
ExtDeviceMode:=TExtDeviceMode(P);
P:=GetProcAddress(DriverHandle, 'DeviceMode');
DeviceModeVar:=TDeviceMode(P);
PrintDC:=0;
end;
destructor TPrinterInfo.Done;
{ Frees up the library taken in the constructor Init.}
begin
FreeLibrary(DriverHandle);
end;
procedure TPrinterInfo.SelectPrinter;
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 9/13
TITLE : Unit for Printing in Windows
{ Displays a Printer Select dialog called PISELECT and changes
the current printer information as is done in Init.}
var
FullDriverName: PChar;
P: TFarProc;
ComboBox: PComboBox;
begin
new(SelectDialog, Init(Nil, 'PISELECT'));
New(ComboBox, InitResource(SelectDialog, id_ComboBox, 80));
SelectDialog^.TransferBuffer:=@ SelectInfo;
if Application^.ExecDialog(SelectDialog) = id_Ok then
begin
FreeLibrary(DriverHandle);
if PrintDC<>0 then DeleteDC(PrintDC);
FreeMem(PrinterType, StrLen(PrinterType)+1);
GetMem(PrinterType, StrLen(@ SelectInfo.Selection)+1);
StrCopy(PrinterType, @ SelectInfo.Selection);
FreeMem(Driver, StrLen(Driver)+1);
FreeMem(Port, StrLen(Port)+1);
GetPrinter(PrinterType, Driver, Port);
GetMem(FullDriverName, 12+1);
StrLCat(StrCopy(FullDriverName, Driver), '.DRV', 12);
DriverHandle:=LoadLibrary(FullDriverName);
FreeMem(FullDriverName, 12+1);
P:=GetProcAddress(DriverHandle, 'ExtDeviceMode');
ExtDeviceMode:=TExtDeviceMode(P);
P:=GetProcAddress(DriverHandle, 'DeviceMode');
DeviceModeVar:=TDeviceMode(P);
end;
end;
function TPrinterInfo.GetPrinterDC: HDC;
{ Retrieves the Device control associated with the printer. May
only be called after a call to the StartDoc method. }
begin
GetPrinterDC:=PrintDC;
end;
var Parent: PWindowsObject;
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 10/13
TITLE : Unit for Printing in Windows
procedure TPrinterInfo.StartDoc(Name: PChar; AbortBox: Boolean);
{ Called immediately before printing is to begin. Establishes
the device control. Sets up the Abort Dialog. And send the
STARTDOC escape call.}
var
AbortProc: TFarProc;
begin
Error:=0;
PrintDC:=CreateDC(Driver, PrinterType, Port, nil);
if LowMemory then
AbortBox := false
else
if AbortBox then
begin
(*
new(AbortDialog, Init(Application^.MainWindow, 'PIABORT'));
AbortDialog^.Create;
*)
AbortProc := MakeProcInstance(@ AbortDlgProc, HInstance);
AbortDlg := CreateDialog(HInstance, 'PIABORT',
GetFocus, AbortProc);
end
else
AbortDialog := Nil;
if AbortBox then
begin
AbortCallBackProc:=MakeProcInstance(@ AbortCallBack,
HInstance);
Escape(PrintDC, SETABORTPROC, 0, AbortCallBackProc, nil);
end;
RasterCaps:=GetDeviceCaps(PrintDC, WINTYPES.RASTERCAPS);
Error:=Escape(PrintDC, WINTYPES.STARTDOC, StrLen(Name),
Name, nil);
end;
procedure TPrinterInfo.NewFrame;
{ Sends the NEWFRAME escape call and performs appropriate error
checking.}
begin
if Error>=0 then
Error:=Escape(PrintDC, WINTYPES.NEWFRAME, 0, nil, nil);
if Error<0 then
case Error of
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 11/13
TITLE : Unit for Printing in Windows
SP_ERROR: MessageBox(GetFocus,
'General Printer Error', nil, mb_Ok or mb_IconStop);
SP_OUTOFDISK: MessageBox(GetFocus,
'No disk space for spooling', nil, mb_Ok or mb_IconStop);
SP_OUTOFMEMORY: MessageBox(GetFocus,
'No memory space for spooling', nil,
mb_Ok or mb_IconStop);
SP_USERABORT: MessageBox(GetFocus,
'Printing Terminated by User', nil,
mb_Ok or mb_IconStop);
else
MessageBox(GetFocus,
'Printing Halted', nil, mb_OK or mb_IconStop);
end;
end;
procedure TPrinterInfo.NextBand(var R:TRect);
{ When Bitmap banding is required, this routine returns the next
rectangular region to be printed. This method is not required
but can speed up printing bitmaps.}
begin
if Error>=0 then
Error:=Escape(PrintDC, WINTYPES.NEXTBAND, 0, nil, @R);
if Error<0 then
case Error of
SP_ERROR: MessageBox(GetFocus,
'General Printer Error', nil, mb_Ok or mb_IconStop);
SP_OUTOFDISK: MessageBox(GetFocus,
'No disk space for spooling', nil, mb_Ok or mb_IconStop);
SP_OUTOFMEMORY: MessageBox(GetFocus,
'No memory space for spooling', nil,
mb_Ok or mb_IconStop);
SP_USERABORT: MessageBox(GetFocus,
'Printing Terminated by User', nil,
mb_Ok or mb_IconStop);
else
MessageBox(GetFocus,
'Printing Halted', nil, mb_OK or mb_IconStop);
end;
end;
procedure TPrinterInfo.EndDoc;
{ Sends the ENDDOC escape call and closes the Abort Dialog if no
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 12/13
TITLE : Unit for Printing in Windows
errors have occurred.}
begin
if Error>=0 then
Error:=Escape(PrintDC, WINTYPES.ENDDOC, 0, nil, nil);
if Error>=0 then
begin
DeleteDC(PrintDC);
if AbortDlg <> 0 then
(*
AbortDialog^.CloseWindow;
*)
DestroyWindow(AbortDlg);
end;
end;
procedure TPrinterInfo.DeviceMode;
{ Calls the printer driver's DeviceMode routine. Normally
displays a dialog allowing the user to change the printer's
configuration.}
begin
DeviceModeVar(GetFocus,
DriverHandle, PrinterType, Port);
end;
function TPrinterInfo.BitMapCapable: boolean;
{ Returns true if the current printing device can handle bitmap
graphics.}
begin
BitMapCapable:=(RasterCaps and RC_BITBLT)<>0;
end;
function TPrinterInfo.BandingRequired: boolean;
{ Returns true if banding of bitmap images will enhance printing
speed.}
begin
BandingRequired:=(RasterCaps and RC_BANDING)<>0;
end;
end.
{ Here is the descriptions of the dialogs PIABORT and PISELECT
found in the resources file PRINTER.RES
PRODUCT : Turbo Pascal NUMBER : 552
VERSION : 1.0
OS : Windows
DATE : August 12, 1992 PAGE : 13/13
TITLE : Unit for Printing in Windows
PIABORT DIALOG DISCARDABLE LOADONCALL PURE MOVEABLE 44, 46, 175,
78
STYLE WS_POPUP | WS_VISIBLE | WS_CAPTION | 0x80L
CAPTION "Printing in Progress"
BEGIN
CONTROL "Press Escape to Halt Printing" 101, "STATIC", WS_CHILD
|
WS_VISIBLE, 37, 17, 98, 12
CONTROL "Escape" 102, "BUTTON", WS_CHILD | WS_VISIBLE |
WS_TABSTOP,
73, 49, 40, 13
END
PISELECT DIALOG DISCARDABLE LOADONCALL PURE MOVEABLE 44, 37, 145,
85
STYLE WS_POPUP | WS_VISIBLE | WS_CAPTION | 0x80L
CAPTION "Select Printer"
BEGIN
CONTROL "COMBOBOX" 101, "COMBOBOX", WS_CHILD | WS_VISIBLE |
WS_VSCROLL |
0x101L, 26, 11, 84, 43
CONTROL "Ok" 1, "BUTTON", WS_CHILD | WS_VISIBLE | WS_TABSTOP,
29, 61, 40, 12
CONTROL "Cancel" 2, "BUTTON", WS_CHILD | WS_VISIBLE |
WS_TABSTOP,
86, 61, 40, 12
END
}
DISCLAIMER: You have the right to use this technical information
subject to the terms of the No-Nonsense License Statement that
you received with the Borland product to which this information
pertains.